home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / BP7BUGS2.ZIP / TRASHSRC.ZIP / PROT386.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-03  |  3KB  |  160 lines
  1. unit Prot386;
  2.  
  3. { Protects 386 calculations from nasty ISRs that trash the 386 registers.
  4.   Just "use prot386" and interrupt handlers will be installed to protect
  5.   calculations. }
  6.  
  7. interface
  8.  
  9. implementation
  10.  
  11. uses
  12.   Dos;
  13.  
  14. const
  15.   Op32 = $66;
  16.  
  17. type
  18.   regs = (reax,rebx,recx,redx);
  19.   TIntRec = record   { This record must be exactly 16 bytes long!!! }
  20.     oldisr : pointer;
  21.     junk : array[1..12] of byte;
  22.   end;
  23.  
  24.   TIntRecArray = array[0..15] of TIntRec;
  25.   PIntRecArray = ^TIntRecArray;
  26.  
  27. { Put the oldisr pointers in the code segment to make the ISR simple. }
  28.  
  29. procedure InterruptRecs; assembler;
  30. { We need 256 bytes here.  Most of it is unused, but it'd make the ISR
  31.   too complicated if I got rid of the Junk field.}
  32. asm
  33.   dd 1,2,3,4,5,6,7,8
  34.   dd 1,2,3,4,5,6,7,8
  35.   dd 1,2,3,4,5,6,7,8
  36.   dd 1,2,3,4,5,6,7,8
  37.   dd 1,2,3,4,5,6,7,8
  38.   dd 1,2,3,4,5,6,7,8
  39.   dd 1,2,3,4,5,6,7,8
  40.   dd 1,2,3,4,5,6,7
  41.   db 1,2,3
  42. end;  { RET is the last byte }
  43.  
  44. const
  45.   PtrOfs = 15*sizeof(TIntRec);
  46.  
  47. procedure FixupISR; assembler;
  48. { This ISR saves and restores the high word of EAX,EBX,ECX,EDX.
  49.   Use it to fix up a bad handler.  Uses 14 bytes of stack space. }
  50. asm
  51.   push bp
  52.   mov bp,sp
  53.   db Op32; push ax
  54.   pop ax
  55.   db Op32; push bx
  56.   pop bx
  57.   db Op32; push cx
  58.   pop cx
  59.   db Op32; push dx
  60.   pop dx
  61.   push word ptr [bp+6]      { This pushes the old flags again }
  62.   mov bp,[bp]                { Restore BP for the old interrupt }
  63.   call dword ptr cs:InterruptRecs[PtrOfs]
  64.   push ax
  65.   pushf
  66.   pop ax                     { Now flags are in AX }
  67.  
  68.   push bp                    { Save the ISR's BP }
  69.   mov bp,sp                  { Set up our frame again }
  70.   add bp,12
  71.   mov word ptr [bp+6],ax      { This way flags on our return will be
  72.                                    as the old ISR returned them. }
  73.   pop ax
  74.   mov word ptr [bp],ax        { as will BP }
  75.   pop ax
  76.  
  77.   push dx
  78.   db Op32; pop dx
  79.   push cx
  80.   db Op32; pop cx
  81.   push bx
  82.   db Op32; pop bx
  83.   push ax
  84.   db Op32; pop ax
  85.   pop bp
  86.   iret
  87. end;
  88.  
  89. procedure Install;
  90. var
  91.   int,irq : byte;
  92.   IntRecs : PIntRecArray;
  93.  
  94.   procedure InstallHandler;
  95.   var
  96.     addr : pointer;
  97.     segmod : byte;
  98.   begin
  99.     GetIntVec(int,IntRecs^[irq].OldIsr);
  100.     segmod := 15-irq;
  101.     Addr := Ptr(Seg(FixupISR)-segmod, Ofs(FixupISR)+16*segmod);
  102.     SetIntVec(int,Addr);
  103.   end;
  104.  
  105. begin
  106.   IntRecs := @InterruptRecs;
  107.   for int := 8 to $F do
  108.   begin
  109.     irq := int-8;
  110.     installhandler;
  111.   end;
  112.   for int := $70 to $77 do
  113.   begin
  114.     irq := int-$70+8;
  115.     installhandler;
  116.   end;
  117. end;
  118.  
  119. procedure UnInstall;
  120. var
  121.   int,irq : byte;
  122.   IntRecs : PIntRecArray;
  123.  
  124.   procedure UnInstallHandler;
  125.   begin
  126.     SetIntVec(int,IntRecs^[irq].OldIsr);
  127.   end;
  128.  
  129. begin
  130.   IntRecs := @InterruptRecs;
  131.   for int := 8 to $F do
  132.   begin
  133.     irq := int-8;
  134.     uninstallhandler;
  135.   end;
  136.   for int := $70 to $77 do
  137.   begin
  138.     irq := int-$70+8;
  139.     uninstallhandler;
  140.   end;
  141. end;
  142.  
  143. var
  144.   OldExitProc : pointer;
  145.  
  146. procedure MyExitProc; far;
  147. begin
  148.   ExitProc := OldExitProc;
  149.   Uninstall;
  150. end;
  151.  
  152. begin
  153.   if test8086 >= 2 then
  154.   begin
  155.     Install;
  156.     OldExitProc := ExitProc;
  157.     ExitProc := @MyExitProc;
  158.   end;
  159. end.
  160.